home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / SWAG / SWAGA_C / ARCHIVES.SWG / 0005_Test for LZH Code.pas < prev    next >
Pascal/Delphi Source File  |  1993-05-28  |  3KB  |  117 lines
  1.  
  2. Program LZHTest;
  3. Uses
  4.   LZH;
  5.  
  6. Const
  7.   MaxBuf = 4096;                       { Must be bigger than the biggest chunk being asked For. }
  8.  
  9. Type
  10.   BufType = Array[1..MaxBuf] of Byte;
  11.   BufPtr = ^BufType;
  12.  
  13. Var
  14.   InBuf, OutBuf : BufPtr;
  15.   inFile, OutFile : File;
  16.   s : String;
  17.   Bytes_Written : LongInt;
  18.   Size : LongInt;
  19.   Temp : Word;
  20.  
  21.  
  22.   {$F+}
  23.   Procedure GetBlock(Var Target; NoBytes : Word; Var Actual_Bytes : Word);
  24.   Const
  25.     Posn : Word = 1;
  26.     Buf : Word = 0;
  27.   Var
  28.     Temp : Word;
  29.   begin
  30.     if (Posn > Buf) or (Posn + NoBytes > succ(Buf)) then
  31.       begin
  32.         if Posn > Buf then
  33.           begin
  34.             blockread(inFile, InBuf^, MaxBuf, Buf);
  35.             Write('+');
  36.           end
  37.         else
  38.           begin
  39.             move(InBuf^[Posn], InBuf^[1], Buf - Posn);
  40.             blockread(inFile, InBuf^[Buf - Posn], MaxBuf - (Buf - Posn), Temp);
  41.             Buf := Buf - Posn + Temp;
  42.             Write('+');
  43.           end;
  44.         if Buf = 0 then
  45.           begin
  46.             Actual_Bytes := 0;
  47.             Writeln;
  48.             Exit;
  49.           end;
  50.         Posn := 1;
  51.       end;
  52.     move(InBuf^[Posn], Target, NoBytes);
  53.     inc(Posn, NoBytes);
  54.     if Posn > succ(Buf) then
  55.       Actual_Bytes := NoBytes - (Posn - succ(Buf))
  56.     else Actual_Bytes := NoBytes;
  57.   end;
  58.  
  59.  
  60.   Procedure PutBlock(Var Source; NoBytes : Word; Var Actual_Bytes : Word);
  61.   Const
  62.     Posn : Word = 1;
  63.   Var
  64.     Temp : Word;
  65.   begin
  66.     if NoBytes = 0 then                { Flush condition }
  67.       begin
  68.         blockWrite(OutFile, OutBuf^, pred(Posn), Temp);
  69.         Exit;
  70.       end;
  71.     if (Posn > MaxBuf) or (Posn + NoBytes > succ(MaxBuf)) then
  72.       begin
  73.         blockWrite(OutFile, OutBuf^, pred(Posn), Temp);
  74.         Posn := 1;
  75.       end;
  76.     move(Source, OutBuf^[Posn], NoBytes);
  77.     inc(Posn, NoBytes);
  78.     Actual_Bytes := NoBytes;
  79.   end;
  80.  
  81.   {$F-}
  82.  
  83. begin
  84.   if (paramcount <> 3) then
  85.     begin
  86.       Writeln('Usage:lzhuf e(Compression)|d(unCompression) inFile outFile');
  87.       halt(1);
  88.     end;
  89.   s := paramstr(1);
  90.   if not(s[1] in ['D', 'E', 'd', 'e']) then
  91.     halt(1);
  92.   assign(inFile, paramstr(2));
  93.   reset(inFile, 1);
  94.   assign(OutFile, paramstr(3));
  95.   reWrite(OutFile, 1);
  96.   new(InBuf);
  97.   new(OutBuf);
  98.   if (upCase(s[1]) = 'E') then
  99.     begin
  100.       Size := Filesize(inFile);
  101.       blockWrite(OutFile, Size, sizeof(LongInt));
  102.       LZHPack(Bytes_Written, GetBlock, PutBlock);
  103.       PutBlock(Size, 0, Temp);
  104.     end
  105.   else
  106.     begin
  107.       blockread(inFile, Size, sizeof(LongInt));
  108.       LZHUnPack(Size, GetBlock, PutBlock);
  109.       PutBlock(Size, 0, Temp);
  110.     end;
  111.   dispose(OutBuf);
  112.   dispose(InBuf);
  113.   close(inFile);
  114.   close(OutFile);
  115. end.
  116.  
  117.